SuperHack/SuperHack CD.bin/CODING/GRAPHICS/VGATUT2.ZIP/VGACIRC.PAS

Pascal/Delphi Source File | 1995-08-11 | 7.5 KB | 363 lines

{$X+}
{$G+}


program Cricle(input, output);

Uses Crt;

Const VGA = $A000;

{------------------------------------------------------------------------}

procedure Set_Vid_mode_to_320x200;

Begin
    asm
       mov ax, 13h      {store 13h in AX}
       int 10h          {call interrupt }
    end;

end;

{------------------------------------------------------------------------}

Procedure Cls (Colour : Byte);
   { This clears the screen to the specified color }
BEGIN
  Fillchar (Mem [$a000:0],64000,colour);
END;

{------------------------------------------------------------------------}

procedure Print_ASM_Pixel (X, Y : Integer; Colour : Byte);

{This is our super fast Pixel algorithum}

begin
    asm
      mov ax, 0a000h   { point AX to video memory   }
      mov es, ax       { move segment pointer to ES }
                       { (actual pointer)           }
      mov bx, [Y]
      mov ax, bx       { register to register is faster by 1 clock}

      mov ah, al       { ax=y*256 + y}
      mov al,  0       { ax=y*256    }

      shl bx, 6        { bx=y*64     }
      add bx, ax       { bx=y*320    }

      add bx, [X]      { ax=(y*320)+x}
      mov di, bx       { move video pointer to correct place}

      mov al, [Colour]
      mov es:[di], al  { move colour to memory }
   end;
end;



{------------------------------------------------------------------------}

procedure Return_Vid_Mode_To_Text;

begin
   asm
    mov ax, 03h      {store 03h in AX}
    int 10h          {call interrupt }
   end;
end;

{------------------------------------------------------------------------}

Procedure DrawCircle( x, y, Radius : integer; Colour : byte);

var
    Temp : real;
    counter : integer;

begin
    Temp:= 0;
     repeat

           x := Round(Radius * cos(Temp));
           y := Round(Radius * sin(Temp));

           Print_ASM_Pixel ( x + 160, y + 100, Colour );
            Temp := Temp + 0.005;

       until (Temp > 6.3) {360 degrees = 6.3 rads}
end;

{------------------------------------------------------------------------}

Procedure ImpDrawCircle( x, y, Radius : integer; Colour : byte);

var xt,
    yt,
    rt,
    temp,
    increment,
    Counter : real;

    NewX,
    NewY,
    NewX1,
    NewY1,

    NewX2,
    NewY2,

    NewX3,
    NewY3,

    NewX4,
    NewY4 : integer;

begin

     if (Radius <= 0) then BEGIN
       Radius := 1;
     END;


     increment := 1/Radius;

     {calculate X, Y change for each segment based on radius}


      repeat

            xt := (Radius * cos(counter));
            x := Round(xt);
            yt := (Radius * sin(counter));
            y := Round(yt);


            If (abs ((xt - x)) < 0.5 ) then BEGIN

                      if (xt > 0) then BEGIN
                         NewX := (x + 1);

                      END

                  else

                      BEGIN
                        NewX :=  (x - 1);
                      END;
               END

            else

                   BEGIN
                     NewX := x;

           END;


      if (  abs(yt - y) < 0.5) then BEGIN

                    if (yt > 0) then BEGIN
                      NewY := (y + 1);

                    END

                  else

                     BEGIN

                      NewY := (y - 1);

                    END;
          END
      else

               BEGIN
                    NewY := Round(y);

                    NewX1 := NewX + X;
                    NewY1 := NewY + Y;

                    NewX2 := (NewX * -1) + X;
                    NewY2 := (NewY * -1) + Y;

                    NewX3 := (NewX * -1) + X;
                    NewY3 :=  NewY + Y;

                    NewX4 :=  NewX + X;
                    NewY4 :=  (NewY * -1) + Y;

      Mem [VGA:(NewY1 * 256) + (NewY1 * 64) + NewX1] := Colour;
      Mem [VGA:(NewY2 * 256) + (NewY2 * 64) + NewX2] := Colour;
      Mem [VGA:(NewY3 * 256) + (NewY3 * 64) + NewX3] := Colour;
      Mem [VGA:(NewY4 * 256) + (NewY4 * 64) + NewX4] := Colour;

       increment := (increment + increment);
            END;
     until (increment > 6.4);
   Mem [VGA:(NewY4 * 256) + (NewY4 * 64) + NewX4] := Colour;

end;

{------------------------------------------------------------------------}


Procedure SmallPoorCircle;

begin
    DrawCircle( 160, 100, 2, 15);

    ReadKey;
end;

{------------------------------------------------------------------------}

Procedure SmallImprCircle;

begin

    ImpDrawCircle( 160, 100, 2, 15);
    ReadKey;
end;

{------------------------------------------------------------------------}

procedure PoorCocen;

var Temp : integer;

begin

Temp := 0;
    repeat
     DrawCircle( 160, 100, Temp, Temp );
     Temp := Temp + 3;
    until (Temp > 100);

    ReadKey;

end;


{------------------------------------------------------------------------}

procedure ImprCocen;

var Temp : integer;

begin

Temp := 0;
    repeat
     ImpDrawCircle( 160, 100, Temp, Temp );
     Temp := Temp + 3;
    until (Temp > 100);

    ReadKey;

end;

{------------------------------------------------------------------------}
procedure PoorRandCirc;

 var Temp : integer;

begin

    for temp := 1 to 50 do BEGIN
    DrawCircle( Random(320), Random(200), Random(100), Random(256) );
    END;
  ReadKey;
end;

{------------------------------------------------------------------------}

procedure ImprRandCirc;

 var Temp : integer;

begin

    for temp := 1 to 100 do
    ImpDrawCircle( Random(320), Random(200), Random(100), Random(256) );

  ReadKey;
end;

{------------------------------------------------------------------------}
procedure Intro;

begin

    ClrScr;

    WriteLn ('Hi there & welcome to the second part of this VGA tutorial.' );
    WriteLn ('This program concerns its self with circles.  We look at two functions');
    WriteLn ('for drawing them....');
    WriteLn ;
    WriteLn ('1.   This routine is slow & inacurate but forms the basis of the second' );
    WriteLn ('     routine.');
    WriteLn ;
    WriteLn ('2.   Much better.  Faster & more accurate.' );
    WriteLn ;
    WriteLn ('Take a look.....' );

    ReadKey;

end;


{------------------------------------------------------------------------}

procedure Outro;

begin

    WriteLn( 'Good.  Now we have a semi-decent circle routine to add to our library.');
    WriteLn( 'I hope youve enjoyed this tutorial and that youll find it useful.');
    WriteLn( 'Many thanks to Richard Griffiths whos been porting this code to Pascal');
    WriteLn( 'for me.');
    WriteLn;
    WriteLn( 'As yet, this tutorial is still not available by FTP but Im working');
    WriteLn( 'on it.Bye for now......  ' );
    WriteLn;
    WriteLn( 'Barny Mercer      : [e-mail] ' );
    WriteLn( '                  : http://www.zetnet.co.uk/users/bmercer/ ');
    WriteLn;
    WriteLn( 'Richard Griffiths : [e-mail] ' );
    WriteLn( '                  : http://www.zetnet.co.uk/users/rgriff/');

    ReadKey;

end;

{------------------------------------------------------------------------}


begin {the Main program}

     Intro;

     Set_Vid_mode_to_320x200;

     Cls (1);
     SmallPoorCircle;
     Cls (1);
     SmallImprCircle;
     Cls (1);
     PoorCocen;
     Cls (1);
     ImprCocen;
     Cls (1);
     PoorRandCirc;
     Cls (1);
     ImprRandCirc;
     Cls (1);

     Return_Vid_Mode_To_Text;

     Outro;
end.